home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / techjock.arc / DEMOTTT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-18  |  39KB  |  986 lines
  1. Program Illustrating_the_Toolkit;
  2. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3. {        This is the main demonstration program in Technojocks Turbo         }
  4. {        Toolkit. The compiled version is in DemoTTT.Exe.                    }
  5. {                                                                            }
  6. {        Please distribute the toolkit to anyone and everyone -- but         }
  7. {        all the files must be distributed together and they should          }
  8. {        not be altered. Enough Crap!                                        }
  9. {                                                                            }
  10. {              Bitches, gripes, thanks, kisses, donations to                 }
  11. {                                                                            }
  12. {                        Bob Ainsbury,                                       }
  13. {                        Technojock,                                         }
  14. {                        P.O. Box 2197,                                      }
  15. {                        Houston TX 77252                                    }
  16. {                                                                            }
  17. {                "In the software business since Tuesday"                    }
  18. {                                                                            }
  19. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  20. Uses CRT, FastTTT, DOS, WinTTT, KeyTTT, MenuTTT, IOTTT, PullTTT, DirTTT, MiscTTT;
  21. var
  22.    Main_Choice,Choice,Error : integer;
  23.    M1 : Menu_record;
  24.    Ch : char;
  25. Const
  26.    Author = 'Bob Ainsbury, Technojock';
  27.  
  28. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  29. {          T H E     M A I N    M E N U    P R O C E D U R E S                }
  30. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  31. Procedure Define_Menu1;
  32. begin
  33.     With M1 do
  34.     begin
  35.         Heading1 := 'TechnoJocks Turbo Toolkit';
  36.         Heading2 := 'Main Menu';
  37.         Topic[1] := '   The Toolkit explained';
  38.         Topic[2] := '   FastTTT Unit';
  39.         Topic[3] := '   WinTTT Unit';
  40.         Topic[4] := '   Menu Procedures';
  41.         Topic[5] := '   IOTTT Unit';
  42.         Topic[6] := '   DirTTT Unit';
  43.         Topic[7] := '   Print documentation';
  44.         Topic[8] := '   Toolkit Unit Summary';
  45.         Topic[9] := '   Quit to DOS';
  46.         TotalPicks := 9;
  47.         PicksPerLine := 1;            {one column of choices}
  48.         Addprefix := 3;               {add function key prefixes}
  49.         TopleftXY[1] := 0;            {system will center menu}
  50.         TopleftXY[2] := 3;            {Y coordinate}
  51.         Boxtype := 5;                 {fancy box}
  52.         If BaseOfScreen = $B800 then
  53.         begin
  54.             Colors[1] := white;           {hi forground}
  55.             Colors[2] := red;            {hi background}
  56.             Colors[3] := lightgray;             {lo foreground}
  57.             Colors[4] := blue;       {lo background}
  58.             Colors[5] := lightcyan;            {box color}
  59.         end
  60.         else
  61.         begin
  62.             Colors[1] := white;           {hi forground}
  63.             Colors[2] := black;            {hi background}
  64.             Colors[3] := black;             {lo foreground}
  65.             Colors[4] := lightgray;       {lo background}
  66.             Colors[5] := white;            {box color}
  67.         end;
  68.         AllowEsc := false;            {inactivate the escape key}
  69.         Margins := 5;
  70. end;  {with M1 do}
  71. end; {Define_Menu1}
  72.  
  73. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  74. {                              O P T I O N      1                             }
  75. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  76. Procedure Toolkit_Explained;
  77. const
  78. X1 = 1;
  79. Y1 = 1;
  80. X2 = 80;
  81. Y2 = 24;
  82. var
  83. C1,C2,C3 : byte;
  84. begin
  85.     If BaseOfScreen = $B800 then
  86.     begin
  87.         C1 := Lightgreen;
  88.         C2 := black;
  89.         C3 := yellow;
  90.     end
  91.     else
  92.     begin
  93.         C1 := white;
  94.         C2 := black;
  95.         C3 := white;
  96.     end;
  97.     Savescreen(1);
  98.     FBox(X1,Y1,X2,Y2,C1,C2,4);
  99.     OffCursor;
  100.     WriteCenter(Y1,C1,C2,' THE TOOLKIT EXPLAINED ');
  101.     WriteAT(X1+3,Y1+2,C3,C2,
  102.     'TechnoJocks Turbo Toolkit is a collection of procedures and functions');
  103.     WriteAT(X1+3,Y1+3,C3,C2,
  104.     'for Turbo Pascal programmers. It will reduce the time taken to write');
  105.     WriteAT(X1+3,Y1+4,C3,C2,
  106.     'applications and is designed for novice and expert programmer alike.');
  107.     WriteAT(X1+3,Y1+6,C3,C2,
  108.     'The real purpose of the Toolkit is to provide easy-to-implement procedures');
  109.     WriteAT(X1+3,Y1+7,C3,C2,
  110.     'that free the programmer from the more tedious and repetitive programming');
  111.     WriteAT(X1+3,Y1+8,C3,C2,
  112.     'chores, such as windows, menus, user input, string formatting, directory');
  113.     WriteAT(X1+3,Y1+9,C3,C2,
  114.     'listings, mouse support etc.');
  115.     WriteAT(X1+3,Y1+11,C3,C2,
  116.    'The Toolkit is being used by many programmers and corporations throughout');
  117.    WriteAT(X1+3,Y1+12,C3,C2,
  118.    'the world. There are TechnoJock Turboholics in Norway, U.K., Japan, Africa');
  119.    WriteAT(X1+3,Y1+13,C3,C2,
  120.    'and all over the USA. Bob is a member of the Association of ShareWare');
  121.    WriteAT(X1+3,Y1+14,C3,C2,
  122.    'Professionals.');
  123.    WriteAT(X1+3,Y1+16,C3,C2,
  124.    'If you use the Toolkit please register your copy and support it''s further');
  125.    WriteAT(X1+3,Y1+17,C3,C2,
  126.    'development. Full registration is $29.95 and this includes 150 page typeset');
  127.       WriteAT(X1+3,Y1+18,C3,C2,
  128.    'Manual - full time students may register for $9.95');
  129.  
  130. WriteAT(X1+17,Y1+20,C1,C2,
  131.    'Enjoy.....');
  132.    WriteAT(X1+28,Y1+22,white,C2,
  133.    'Bob Ainsbury, TechnoJock, Houston.');
  134.    WriteAT(X2-20,Y2,C1,C2,' press any key ... ');
  135.    Ch := GetKey;
  136.    RestoreScreen(1);
  137.    DisposeScreen(1);
  138. end;
  139.  
  140. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  141. {                              O P T I O N      2                             }
  142. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  143. Procedure Explain_Fastwrite;
  144. const
  145. X1 = 1;
  146. Y1 = 1;
  147. X2 = 80;
  148. Y2 = 25;
  149. C1 = white;
  150. C2 = yellow;
  151. C3 = black;
  152. Max_Picks = 14;
  153.  
  154.       Procedure MainText;
  155.       begin
  156.       Box(X1,Y1,X2,Y2,C2,C3,1);
  157.       Horizline(3,77,19,red,black,1);
  158.       WriteCenter(Y1+1,C2,C3,'FastTTT Unit');
  159.       WriteAT(X1+5,Y1+3,C1,C3,
  160.       'The FastTTT unit contains a host of procedures for updating the');
  161.       WriteAT(X1+5,Y1+4,C1,C3,
  162.       'screen, at speeds exceeding an Izuzu.');
  163.       WriteAT(X1+5,Y1+6,C1,C3,
  164.       'The latest version of Turbo Pascal has some significantly improved');
  165.       WriteAT(X1+5,Y1+7,C1,C3,
  166.       'screen writing procedures. But the FastTTT unit is much faster still,');
  167.       WriteAT(X1+5,Y1+8,C1,C3,
  168.       'especially on systems that are prone to snow.');
  169.       WriteAT(X1+5,Y1+10,C1,C3,
  170.       'The procedures are designed to work on IBM systems and 100% compatibles.');
  171.       WriteAT(X1+5,Y1+11,C1,C3,
  172.       'Listed below are some of the main Fastwrit procedures, move the cursor');
  173.       WriteAT(X1+5,Y1+12,C1,C3,
  174.       'to see a fuller description. Press [End] or [Esc] to return to the menu.');
  175.       end;  {sub proc Main_text}
  176.  
  177.       Procedure WriteOption(Pick,F,B:integer);
  178.       const
  179.       Lineone = 15;
  180.       LeftTab = 6;
  181.       Tab = 18;
  182.       begin
  183.       Case Pick of
  184.       1 : WriteAT(LeftTab,Lineone,F,B,             '    Box          ');
  185.       2 : WriteAT(LeftTab+Tab,Lineone,F,B,         '    HorizLine    ');
  186.       3 : WriteAT(LeftTab+2*Tab,LineOne,F,B,       '    VertLine     ');
  187.       4 : WriteAT(LeftTab+3*Tab,LineOne,F,B,       '    WriteAT      ');
  188.       5 : WriteAT(LeftTab,LineOne+1,F,B,           '    ClearText    ');
  189.       6 : WriteAT(LeftTab+Tab,LineOne+1,F,B,       '    WriteCenter  ');
  190.       7 : WriteAT(LeftTab+2*Tab,LineOne+1,F,B,     '    WriteBetween ');
  191.       8 : WriteAT(LeftTab+3*Tab,LineOne+1,F,B,     '    WriteVert    ');
  192.       9 : WriteAT(LeftTab,Lineone+2,F,B,           '    FBox         ');
  193.       10: WriteAt(LeftTab+tab,LineOne+2,F,B,       '    GrowFBox     ');
  194.       11: WriteAt(LeftTab+2*tab,LineOne+2,F,B,     '    ClearLine    ');
  195.       12: WriteAt(LeftTab+3*Tab,LineOne+2,F,B,     '    Attr         ');
  196.       13: WriteAT(LeftTab,Lineone+3,F,B,           '    FastWrite    ');
  197.       14: WriteAt(LeftTab+tab,LineOne+3,F,B,       '    PlainWrite   ');
  198.       end; {case}
  199.       end; {WriteOption}
  200.  
  201.       Procedure Hilite(Pick:integer);
  202.       begin
  203.       WriteOption(Pick,White,red);
  204.       end;   {HiLite}
  205.  
  206.       Procedure LoLite(Pick:integer);
  207.       begin
  208.       WriteOption(Pick,Lightgray,C3);
  209.       end;   {LoLite}
  210.  
  211.       Procedure DisplayDescription(Pick : integer);
  212.       const
  213.       X = 7;
  214.       Y = 20;
  215.       C = yellow;
  216.       begin
  217.       case Pick of
  218.       1 : begin
  219.            WriteAT(X,Y,C,black,  'Syntax :  Box(X1,Y1,X2,Y2,F,B,boxtype : integer);                   ');
  220.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color ');
  221.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates what line ');
  222.            WriteAT(X,Y+4,C,black,'          type to use i.e. single, double or combined.              ');
  223.           end;
  224.       2 : begin
  225.            WriteAT(X,Y,C,black,  'Syntax :  HorizLine(X1,X2,Y,F,B,LineType:integer);                  ');
  226.            WriteAT(X,Y+2,C,black,'Purpose : Draws a horizontal line on the screen in foreground color ');
  227.            WriteAT(X,Y+3,C,black,'          F and background color B. The linetype indicates what line');
  228.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  229.           end;
  230.       3 : begin
  231.            WriteAT(X,Y,C,black,  'Syntax :  VertLine(X,Y1,Y2,F,B,LineType:integer);                   ');
  232.            WriteAT(X,Y+2,C,black,'Purpose : Draws a vertical line on the screen in foreground color F ');
  233.            WriteAT(X,Y+3,C,black,'          and background color B. The linetype indicates what line  ');
  234.            WriteAT(X,Y+4,C,black,'          type to use i.e. single or double.                        ');
  235.           end;
  236.       4 : begin
  237.            WriteAT(X,Y,C,black,  'Syntax :  WriteAT(X,Y,F,B:integer;ST:string80);                     ');
  238.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string St very quickly on the screen starting  ');
  239.            WriteAT(X,Y+3,C,black,'          at (X,Y) in foreground color F and background color B. The');
  240.            WriteAT(X,Y+4,C,black,'          string may be concatenated e.g. ''Techno''+''Jock''.          ');
  241.           end;
  242.       5 : begin
  243.            WriteAT(X,Y,C,black,  'Syntax :  ClearText(X1,Y1,X2,Y2,F,B:integer);                       ');
  244.            WriteAT(X,Y+2,C,black,'Purpose : Clears the characters for a rectangular area on the screen');
  245.            WriteAT(X,Y+3,C,black,'          and displays background color B. The attribute for the    ');
  246.            WriteAT(X,Y+4,C,black,'          foreground is set to F. Unaffected by Window setting.     ');
  247.           end;
  248.       6 : begin
  249.            WriteAT(X,Y,C,black,  'Syntax :  WriteCenter(Lineno,F,B:integer;ST:string80);              ');
  250.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen in the    ');
  251.            WriteAT(X,Y+3,C,black,'          center of line Lineno in foreground color F and back-     ');
  252.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  253.           end;
  254.       7 : begin
  255.            WriteAT(X,Y,C,black,  'Syntax :  WriteBetween(X1,X2,Y,F,B:integer;ST:string80);            ');
  256.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST very quickly on the screen centered  ');
  257.            WriteAT(X,Y+3,C,black,'          between X1 and X2 on line Y, in foreground F and back-    ');
  258.            WriteAT(X,Y+4,C,black,'          ground color B. The string may be concatenated.           ');
  259.           end;
  260.       8 : begin
  261.            WriteAT(X,Y,C,black,  'Syntax :  WriteVert(X,Y,F,B;ST:string80);                           ');
  262.            WriteAT(X,Y+2,C,black,'Purpose : Writes the string ST vertically on the screen starting at ');
  263.            WriteAT(X,Y+3,C,black,'          coordinate (X,Y) and continuing down the screen, in fore- ');
  264.            WriteAT(X,Y+4,C,black,'          ground color F and background color B.                    ');
  265.           end;
  266.       9 : begin
  267.            WriteAT(X,Y,C,black,  'Syntax :  FBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);                 ');
  268.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color');
  269.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line');
  270.            WriteAT(X,Y+4,C,black,'          style. This is similar to Box except the box is cleared.');
  271.           end;
  272.       10: begin
  273.            WriteAT(X,Y,C,black,  'Syntax :  GrowFBox(X1,Y1,X2,Y2,F,B,Boxtype:Integer);             ');
  274.            WriteAT(X,Y+2,C,black,'Purpose : Draws a rectangular box on the screen in foreground color');
  275.            WriteAT(X,Y+3,C,black,'          F and background color B. The boxtype indicates the line');
  276.            WriteAT(X,Y+4,C,black,'          style. This is similar to FBox except the box explodes.');
  277.           end;
  278.       11: begin
  279.            WriteAT(X,Y,C,black,  'Syntax :  ClearLine(Y,F,B:integer);                               ');
  280.            WriteAT(X,Y+2,C,black,'Purpose : All text on screen line Y is cleared. The actual display  ');
  281.            WriteAT(X,Y+3,C,black,'          color of the line will be set to B.                       ');
  282.            WriteAT(X,Y+4,C,black,'                                                                    ');
  283.           end;
  284.       12: begin
  285.            WriteAT(X,Y,C,black,  'Syntax :  Attr(F,B):byte;                                           ');
  286.            WriteAT(X,Y+2,C,black,'Purpose : Combines the foreground color F with the background       ');
  287.            WriteAT(X,Y+3,C,black,'          color B and returns the resulting attribute byte.         ');
  288.            WriteAT(X,Y+4,C,black,'                                                                    ');
  289.           end;
  290.       13: begin
  291.            WriteAT(X,Y,C,black,  'Syntax :  Fastwrite(X,Y,F,B : byte; Str : string);                  ');
  292.            WriteAT(X,Y+2,C,black,'Purpose : This is the core procedure used by the others in the      ');
  293.            WriteAT(X,Y+3,C,black,'          Toolkit. String Str is wriiten on the screen in foreground');
  294.            WriteAT(X,Y+4,C,black,'          F & background B at location (X,Y) el quicko.             ');
  295.           end;
  296.       14: begin
  297.            WriteAT(X,Y,C,black,  'Syntax :  PlainWrite(X,Y:byte; Str: string);                        ');
  298.            WriteAT(X,Y+2,C,black,'Purpose : This is even quicker than FastWrite but it uses the       ');
  299.            WriteAT(X,Y+3,C,black,'          default color attibute already assigned.                  ');
  300.            WriteAT(X,Y+4,C,black,'                                                                    ');
  301.           end;
  302.       end; {case}
  303.       end; {DisplayDescription}
  304.  
  305.       Procedure Keystroke;
  306.       const
  307.           CursorUp = #200;
  308.           CursorDown = #208;
  309.           CursorLeft = #203;
  310.           CursorRight = #205;
  311.           EndKey = #207;
  312.       var
  313.       Allover : boolean;
  314.       I,CurrentPick : integer;
  315.       begin
  316.           Allover := false;
  317.           CurrentPick := 1;
  318.           For I := 1 to Max_Picks do
  319.               LoLite(I);
  320.           HiLite(CurrentPick);
  321.           Repeat
  322.               Ch := getkey;
  323.               Case upcase(Ch) of
  324.               CursorUp :      If CurrentPick > 4 then
  325.                               begin
  326.                                   LoLite(CurrentPick);
  327.                                   CurrentPick := CurrentPick - 4;
  328.                                   HiLite(CurrentPick);
  329.                               end;
  330.               CursorDown :    If CurrentPick <= Max_Picks - 4 then
  331.                               begin
  332.                                   LoLite(CurrentPick);
  333.                                   CurrentPick := CurrentPick + 4;
  334.                                   HiLite(CurrentPick);
  335.                               end;
  336.              ' ',
  337.              CursorRight :   begin
  338.                                  LoLite(CurrentPick);
  339.                                  If CurrentPick < Max_Picks then
  340.                                      CurrentPick := CurrentPick + 1
  341.                                  else
  342.                                      CurrentPick := 1;
  343.                                  HiLite(CurrentPick);
  344.                              end;
  345.             CursorLeft :    begin
  346.                                 LoLite(CurrentPick);
  347.                                 If CurrentPick > 1 then
  348.                                    CurrentPick := CurrentPick - 1
  349.                                 else
  350.                                    CurrentPick := Max_Picks;
  351.                                 HiLite(CurrentPick);
  352.                             end;
  353.             #027,
  354.             EndKey :        Allover := true;
  355.             end; {case}
  356.             DisplayDescription(CurrentPick);
  357.       Until Allover;
  358.       end;  {Keystroke}
  359.  
  360.  
  361. begin       {Explain_Fastwrite}
  362.     SaveScreen(1);
  363.     Clrscr;
  364.     OffCursor;
  365.     MainText;
  366.     DisplayDescription(1);
  367.     Keystroke;
  368.     RestoreScreen(1);
  369.     DisposeScreen(1);
  370. end;  {proc Explain_Fastwrite}
  371.  
  372. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  373. {                              O P T I O N      3                             }
  374. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  375. Procedure Explain_Windows;
  376. var
  377.    I : integer;
  378.    c1,c2,c3,c4,c5,c6: byte;
  379.  
  380. begin
  381.     If BaseOfScreen = $B800 then
  382.     begin
  383.         C1 := yellow;
  384.         C2 := green;
  385.         C3 := white;
  386.         C4 := white;
  387.         C5 := red;
  388.         C6 := magenta;
  389.     end
  390.     else
  391.     begin
  392.         C1 := black;
  393.         C2 := lightgray;
  394.         C3 := white;
  395.         C4 := white;
  396.         C5 := black;
  397.         C6 := black;
  398.     end;
  399.     Savescreen(1);
  400.     OffCursor;
  401.     ClrScr;
  402.     MkWin(1,1,35,14,c1,c2,2);
  403.     WriteBetween(1,35,2,C1,c2,'Window.TTT');
  404.     WriteAt(3,4,c3,c2,'The Window procedures provide');
  405.     WriteAT(3,5,c3,c2,'tools for easily writing flash');
  406.     WriteAT(3,6,c3,c2,'up window routines. ');
  407.     WriteAT(3,8,c3,c2,'They also include procedures');
  408.     WriteAT(3,9,c3,c2,'for saving and restoring screen');
  409.     WriteAT(3,10,c3,c2,'images.');
  410.     WriteAT(3,13,c3,c2,'... press any key.');
  411.     DelayKey(4000);
  412.     Mkwin(34,7,66,20,c4,c5,3);
  413.     WriteAT(36,9,c4,c5, 'The windows can be placed any');
  414.     WriteAT(36,10,c4,c5,'where on the screen and both');
  415.     WriteAT(36,11,c4,c5,'the border style and colors ');
  416.     WriteAT(36,12,c4,c5,'can be easily altered.');
  417.     DelayKey(3000);
  418.     Mkwin(20,13,68,25,c4,c6,1);
  419.     WriteAT(22,15,c4,c6,'The WinTTT unit includes a host of Windowing ');
  420.     WriteAT(22,16,c4,c6,'procedures, and a collection of fancy screen ');
  421.     WriteAT(22,17,c4,c6,'restoring and sliding procedures.            ');
  422.     WriteAT(22,19,c4,c6,'There are three smaller demo programs on the ');
  423.     WriteAT(22,20,c4,c6,'distribution disk that further illustrate the');
  424.     WriteAT(22,21,c4,c6,'power of this unit: WinDem, ScrnDem & SaveDem');
  425.     WriteAT(22,22,c4,c6,'.pas.                                       ');
  426.     WriteAT(22,24,c4,c6,'Press any key to see some screen manipulation');
  427.     Ch := getkey;
  428.     Rmwin;
  429.     Delay(300);
  430.     Rmwin;
  431.     Delay(300);
  432.     Rmwin;
  433.     Delay(300);
  434.     Rmwin;
  435.     SlideRestoreScreen(1,left);
  436.     SlideRestoreScreen(1,up);
  437.     SlideRestoreScreen(1,right);
  438.     DisposeScreen(1);
  439. end;
  440.  
  441. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  442. {                              O P T I O N      4                             }
  443. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  444. Procedure PullDemo;
  445. var
  446. TheMenu : MenuDesc;   {Array holding the menu definitions}
  447.  
  448.        Procedure Define_Demo_Menu;
  449.        begin
  450.            Fillchar(Themenu,sizeof(Themenu),#0);
  451.            TheMenu[1] := '\File';      {menu definition for pull down menu}
  452.            TheMenu[2] := 'Load        ';
  453.            TheMenu[3] := 'New         ';
  454.            TheMenu[4] := 'Save        ';
  455.            TheMenu[5] := 'Write to    ';
  456.            TheMenu[6] := 'Directory   ';
  457.            TheMenu[7] := 'Change dir  ';
  458.            TheMenu[8] := 'OS shell    ';
  459.            TheMenu[9] := 'Quit        ';
  460.  
  461.            TheMenu[10] :=  '\Edit ';
  462.  
  463.            TheMenu[11] :=  '\Run ';
  464.  
  465.            TheMenu[12] := '\Compile     ';
  466.            TheMenu[13] := 'Make         ';
  467.            TheMenu[14] := 'Build        ';
  468.            TheMenu[15] := 'Destination  ';
  469.            TheMenu[16] := 'Find Error   ';
  470.            TheMenu[17] := 'Primary file ';
  471.            TheMenu[18] := 'Find         ';
  472.            TheMenu[19] := 'find/Replace ';
  473.            TheMenu[20] := 'find Next    ';
  474.            TheMenu[21] := 'Get Info     ';
  475.  
  476.            TheMenu[22] := '\Options';
  477.            TheMenu[23] := 'Compiler    ';
  478.            TheMenu[24] := 'Environment ';
  479.            TheMenu[25] := 'Directories ';
  480.            TheMenu[26] := 'Parameters  ';
  481.            TheMenu[27] := 'Load Options';
  482.            TheMenu[28] := 'Save Options';
  483.            TheMenu[29] := '\\';
  484.  
  485.       end; {Proc Define demo menu}
  486.  
  487.       Procedure Fill_Screen_With_Junk;
  488.       var I,J : integer;
  489.       begin
  490.           ClrScr;
  491.           Fillscreen(1,1,80,23,15,0,chr(001));
  492.           Writecenter(15,lightgray,black,' Use the cursor keys... recognize the menu? ');
  493.       end;
  494.  
  495. var
  496.  Major,Minor : byte;
  497.  Ch : char;
  498.  
  499. begin
  500.     Define_Demo_Menu;
  501.     Fill_Screen_With_Junk;
  502.     Major := 1;
  503.     Minor := 1;
  504.     With PM do
  505.     begin
  506.         Style := 0;  {0 no border, 1 single border, 2 double border}
  507.         TopX :=  1;
  508.         TopY := 2;
  509.         ScreenNo := 3;
  510.         Gap :=  5;
  511.         RemoveMenu := false;
  512.     end; {With}
  513.     Pull_Menu(TheMenu,Major,Minor);
  514.     GotoXY(1,20);
  515.     If Major = 0 then
  516.        writeln('You escaped ')
  517.     else
  518.        writeln('You selected main menu ',Major,' and sub-topic ',Minor,' ');
  519.     Writeln('The menu can also be displayed with single or double borders!');
  520.     writeln;
  521.     Writeln('Press any key to return to main menu.......');
  522.     Ch := Readkey;
  523. end;
  524.  
  525.  
  526. Procedure Explain_Menu;
  527. var
  528.   P,code : integer;
  529.   C1,C2,C3: byte;
  530.  
  531.     Procedure Instructions(Number:integer);
  532.     begin
  533.         P := 1;
  534.         Case Number of
  535.         1 : begin
  536.                 WriteAT(9,23,white,black,
  537.                 'This is a mock up of the Main menu but changed to two picks per line,');
  538.                 WriteAT(9,24,white,black,
  539.                 'and moved to the left. Play with the cursor and select an option.    ');
  540.             end;
  541.         2 : begin
  542.                 WriteAT(9,23,white,black,
  543.                 'Now the menu has been changed back to one pick per line and the      ');
  544.                 WriteAT(9,24,white,black,
  545.                 'prefix has changed to a letter. Press a letter or move & Enter.      ');
  546.             end;
  547.         3 : begin
  548.                 WriteAT(9,23,white,black,
  549.                 'Last one I promise! Now the prefix is a number and we''ve changed    ');
  550.                 WriteAT(9,24,white,black,
  551.                 'the colors. Select an option and press Enter.                        ');
  552.             end;
  553.     end; {case}
  554.     end; {sub proc Instructions}
  555.  
  556. begin
  557.     If BaseOfScreen = $B800 then
  558.     begin
  559.         C1 := lightred;
  560.         C2 := red;
  561.     end
  562.     else
  563.     begin
  564.         C1 := lightgray;
  565.         C2 := lightgray;
  566.     end;
  567.     Savescreen(1);
  568.     Clrscr;
  569.     OffCursor;
  570.     Box(1,1,80,25,C1,black,1);
  571.     WriteCenter(3,c1,black,'The MenuTTT Unit');
  572.     WriteAT(3,5,white,black,
  573.     'The Toolkit contains two menu units: one for pull down menus and the other ');
  574.     WriteAT(3,6,white,black,
  575.     'for single boxed menus. Menus area big chore and seem to be something we all');
  576.     WriteAT(3,7,white,black,
  577.     'leave to the end of the development. BUT a friendly and consistent interface');
  578.     WriteAT(3,8,white,black,
  579.     'is fundamental to the acceptance of a program. Menu.TTT is a must.');
  580.     WriteAT(3,10,white,black,
  581.     'The main menu of this demo program is constructed using MenuTTT. All you have');
  582.     WriteAT(3,11,white,black,
  583.     'to do is define a menu record and call the procedure DisplayMenu -- thats    ');
  584.     WriteAT(3,12,white,black,
  585.     'right, there is only one procedure.');
  586.     WriteAT(3,14,white,black,
  587.     'In the menu record you detail the following : a heading, the number of picks,');
  588.     WriteAT(3,15,white,black,
  589.     'the menu text for each pick, the number of picks on a line (typically 1),    ');
  590.     WriteAT(3,16,white,black,
  591.     'the box location and the desired colors, you also indicate whether the Esc   ');
  592.     WriteAT(3,17,white,black,
  593.     'key is enabled. That is all there is to it.');
  594.     WriteAT(3,19,white,black,
  595.     'The menu procedure includes extensive error checking and wherever possible   ');
  596.     WriteAT(3,20,white,black,
  597.     'if an invalid value is found the system will correct. For example if the box ');
  598.     WriteAT(3,21,white,black,
  599.     'will not fit on the screen the procedure will shift it so that it does fit.  ');
  600.     WriteAt(3,23,c1,black,
  601.    'To illustrate how easy it is to modify and change menus, lets display the ');
  602.    WriteAt(3,24,c1,black,
  603.    'main menu a few different ways by simply changing the menu record.        ');
  604.    WriteAt(60,25,c1,black,' press any key .... ');
  605.    Ch := getkey;
  606.    Clrscr;
  607.    Offcursor;
  608.    Box(1,22,80,25,c1,black,1);
  609.    With M1 do
  610.    begin
  611.        PicksPerLine := 2;
  612.        TopleftXY[1] := 1;
  613.    end;
  614.    Instructions(1);
  615.    Displaymenu(M1,false,P,code);
  616.    With M1 do
  617.    begin
  618.        PicksPerLine := 1;
  619.        TopleftXY[1] := 55;
  620.        TopleftXY[2] := 6;
  621.        Addprefix := 2;
  622.    end;
  623.    Instructions(2);
  624.    Displaymenu(M1,false,P,code);
  625.    With M1 do
  626.    begin
  627.        TopleftXY[1] := 15;
  628.        TopleftXY[2] := 5;
  629.        Addprefix := 1;
  630.        If baseOfSCreen = $B800 then
  631.        begin
  632.            Colors[1] := yellow;
  633.            Colors[2] := green;
  634.            Colors[3] := lightgreen;
  635.            Colors[4] := red;
  636.            Colors[5] := white;
  637.        end;
  638.    end;
  639.    Instructions(3);
  640.    Displaymenu(M1,false,P,code);
  641.    Mkwin(5,10,70,17,white,c2,2);
  642.    Offcursor;
  643.    WriteAT(15,12,white,c2,'All these modifications were effected by making');
  644.    WriteAT(15,13,white,c2,'simple changes to the menu record.             ');
  645.    WriteAT(15,15,white,c2,'Now lets check out the pull menu option.       ');
  646.    WriteAT(50,17,white,c2,' press any key .... ');
  647.    Define_Menu1;           {set it all back to normal}
  648.    Ch := getkey;
  649.    Rmwin;
  650.    PullDemo;
  651.    RestoreScreen(1);
  652.    DisposeScreen(1);
  653.    Offcursor;
  654. end;
  655. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  656. {                              O P T I O N      5                             }
  657. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  658. {$F+}
  659. Procedure Help_EditKeys(Ch:Char; Fieldid : integer;var ReturnStr: string);
  660. var C1,C2,c3 : byte;
  661. begin
  662.     If BaseOfScreen = $b800 then
  663.     begin
  664.         C1 := lightcyan;
  665.         C2 := white;
  666.         C3 := blue;
  667.     end
  668.     else
  669.     begin
  670.         C1 := white;
  671.         C2 := black;
  672.         C3 := lightgray;
  673.     end;
  674.     If Ch <> #187 then exit;
  675.     Mkwin(40,1,80,25,C1,c3,2);
  676.     WriteBetween(40,80,2,C1,c3,'IO Editing Keys');
  677.     WriteAT(42,3,c2,c3,'The operative edit keys are defined');
  678.     WriteAT(42,4,c2,c3,'in IOTTT.pas. They may be modified to');
  679.     WriteAT(42,5,c2,c3,'suit your needs. The defaults are:  ');
  680.     WriteAT(42,7,c2,c3, 'Move Up      '+chr(024));
  681.     WriteAT(42,8,c2,c3, 'Move Down    '+chr(025));
  682.     WriteAT(42,9,c2,c3,'Move Right   Ctrl -'+chr(016)+', Tab or Enter');
  683.     WriteAT(42,10,c2,c3,'Move Left    Ctrl '+chr(017)+'- or ShiftTab');
  684.     WriteAT(42,12,c2,c3,'Insert       Press [Ins] to toggle');
  685.     WriteAT(42,14,c2,c3,'Del Char     [Del]  or  [Backspace]');
  686.     WriteAT(42,15,c2,c3,'Del Field    Alt-D');
  687.     WriteAT(42,16,c2,c3,'Del Global   Alt-E');
  688.     WriteAT(42,18,c2,c3,'Update       [End]');
  689.     WriteAT(42,19,c2,c3,'Abort        [Esc]');
  690.     WriteAT(42,21,c2,c3,'Note the abort key can be disabled,');
  691.     WriteAT(42,22,c2,c3,'as it is in this example. Just press');
  692.     WriteAT(42,23,c2,c3,'[End] to finish the example.');
  693.     Ch := getkey;
  694.     Rmwin;
  695. end;
  696. {$F-}
  697.  
  698. Procedure Explain_IO;
  699.  
  700.      Procedure Display_Text;
  701.      var C1,C2 : byte;
  702.      begin
  703.          If BaseOfScreen = $b800 then
  704.          begin
  705.              C1 := yellow;
  706.              C2 := lightgreen;
  707.          end
  708.          else
  709.          begin
  710.              C1 := lightgray;
  711.              C2 := white;
  712.          end;
  713.          Clrscr;
  714.          Box(1,1,80,11,C1,black,3);
  715.   WriteCenter(2,C1,black,'The IOTTT Unit');
  716.   WriteAT(3,4,c2,black,
  717.   'One of the (few) short comings of Turbo Pascal is its very limited support');
  718.   WriteAT(3,5,c2,black,
  719.   'for screen input that gives the user a chance to move around the screen and');
  720.   WriteAT(3,6,c2,black,
  721.   'and edit the input. Thats why I developed the IOTTT unit.');
  722.   WriteAT(3,8,c2,black,
  723.   'These IO procedures allow you to display input fields with format controls');
  724.   WriteAT(3,9,c2,black,
  725.   'e.g. all capitals or only numbers. There are many features to the Kit. The');
  726.   WriteAT(3,10,c2,black,
  727.   'example below illustrates some of the power of this easy to use Kit.');
  728.   end;
  729.  
  730.   Procedure IO_Example;
  731.   var
  732.   s1,s2,s3,s4,s5,s6:string;
  733.   retcode : integer;
  734.   begin
  735.   Box(3,13,78,25,white,black,1);
  736.   Horizline(4,77,15,white,black,1);
  737.   Textcolor(white);
  738.   GotoXY(3,15);write(chr(195));
  739.   GotoXY(78,15);write(chr(180));
  740.   Textcolor(lightred);
  741.   GotoXY(20,14);write(chr(004));
  742.   GotoXY(57,14);write(chr(004));
  743.   GotoXY(22,14);write(chr(004));
  744.   GotoXY(59,14);write(chr(004));
  745.   Textcolor(yellow);
  746.   GotoXY(21,14);write(chr(004));
  747.   GotoXY(58,14);write(chr(004));
  748.   Offcursor;
  749.   WriteCenter(14,Lightgray,black,'Technojocks Inventory Control');
  750.   WriteAt(22,17,white,black,'Catalogue/Part Number');
  751.   WriteAT(10,19,white,black,'Description');
  752.   WriteAT(10,21,white,black,'Quantity');
  753.   WriteAT(50,21,white,black,'Units');
  754.   WriteAT(10,23,white,black,'Shelf');
  755.   WriteAT(50,23,white,black,'Bin No.');
  756.   WriteAT(66,16,white,black,'F1 for HELP');
  757.   S1 := '';
  758.   S2 := '';
  759.   S3 := '';
  760.   S4 := '';
  761.   S5 := '';
  762.   S6 := '0001';
  763.   IO_Setfields(6);
  764.   IO_Soundbeeper(false);
  765.   IO_Allowesc(true);
  766.   IO_UserHook := @Help_Editkeys;
  767.   IO_DefineStr(1,   6,2,6,2,    45,17,  S1,'(####-###)/ ##');
  768.   IO_DefineStr(2,   1,3,1,3,    23,19,  S2,replicate(50,'*'));
  769.   IO_DefineSTR(3,   2,4,2,4,    23,21,  S3,'#####');
  770.   IO_DefineStr(4,   3,5,3,5,    60,21,  S4,'!!!!!!!!!!!!!');
  771.   IO_DefineStr(5,   4,6,4,6,    23,23,  S5,'@@ / @');
  772.   IO_DefineStr(6,   5,1,5,1,    60,23,  S6,'####');
  773.   IO_DefineMsg(1,   13,25, 'Enter the TTT catalogue number (letters not accepted)');
  774.   IO_DefineMsg(2,   15,25, 'Enter the item description from the Purchase Order');
  775.   IO_DefineMsg(4,   25,25, '(note: Units converted to capitals)');
  776.   IO_DefineMsg(5,   20,25, 'Only letters and punctuation chars allowed');
  777.   IO_DefineMsg(6,   20,25, 'Check details and press [End] to update');
  778.   OnCursor;
  779.   IO_Edit(Retcode);
  780.   OffCursor;
  781.   IO_ResetFields;
  782.   end;
  783. begin
  784. SaveScreen(1);
  785. Display_Text;
  786. IO_Example;
  787. RestoreScreen(1);
  788. DisposeScreen(1);
  789. end;
  790. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  791. {                              O P T I O N      6                             }
  792. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  793. Procedure Explain_Dir;
  794.  
  795. Var
  796.  StartPath, Path, Mask, Chosen_File : string;
  797.  Ch : char;
  798.  C1,C2,C3 : byte;
  799. begin
  800.     If BaseOfScreen = $b800 then
  801.     begin
  802.         C1 := Yellow;
  803.         C2 := lightgray;
  804.         C3 := blue;
  805.     end
  806.     else
  807.     begin
  808.         C1 := white;
  809.         C2 := black;
  810.         C3 := lightgray;
  811.     end;
  812.     SaveScreen(1);
  813.     ClrScr;
  814.     FBox(1,1,80,10,C1,c3,2);
  815.     WriteCenter(2,C1,C3,'The DirTTT Unit');
  816.     WriteAT(5,3,c2,c3,
  817.     ' The DirTTT unit provides a single procedure for displaying a directory');
  818.     WriteAT(5,4,c2,c3,
  819.     ' in a Sidekick-like dialogue box. You can optionally display the file');
  820.     WriteAT(5,5,c2,c3,
  821.     ' details of the currently selected field, and allow the users to change');
  822.     WriteAT(5,6,c2,c3,
  823.     ' directories. Only files matching a specified file mask will be shown.');
  824.     WriteAT(5,8,c2,c3,
  825.     ' In the example below ''*.*'' is the mask, use the cursor keys to change');
  826.     WriteAT(5,9,c2,c3,
  827.     ' selections, and select a directory to change to that directory.');
  828.  
  829.     GetDir(0,StartPath);
  830.     Path := StartPath;
  831.     Mask := '*.*';
  832.     With D do
  833.     begin
  834.         Cols := 5;
  835.         Rows := 8;
  836.         TopY := 13;
  837.         AllowEsc := false;
  838.     end;
  839.     Chosen_File := Display_Directory(Path,Mask);
  840.     GotoXy(1,25);
  841.     If Chosen_File = #027 then
  842.         Write('You escaped')
  843.     else
  844.         Write('You selected file ',Chosen_File);
  845.    Write('   Press any key to return to the menu');
  846.    {$I-}
  847.    ChDir(StartPath);
  848.    {$I+}
  849.    Ch := Getkey;
  850.    RestoreScreen(1);
  851.    DisposeScreen(1);
  852. end;
  853.  
  854. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  855. {                              O P T I O N      7                             }
  856. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  857. Procedure Printout;
  858. begin
  859. Mkwin(10,8,70,18,white,red,1);
  860. Offcursor;
  861. WriteAT(15,10,white,red,'The documentation is compressed in a file Manual.exe.');
  862. WriteAT(15,11,white,red,'Execute this file and the file Manual.TTT will self  ');
  863. WriteAT(15,12,white,red,'extract. The manual contains no formatting chars, &');
  864. WriteAT(15,13,white,red,'is 80 characters wide by 66 lines per page.');
  865. WriteAT(15,15,white,red,'At the DOS prompt type Print Manual.TTT. Be warned');
  866. WriteAT(15,16,white,red,'the documentation is good but it''s more than 100 pages.');
  867. WriteAT(50,18,white,red,' press any key .... ');
  868. Ch := getkey;
  869. Rmwin;
  870. end;
  871. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  872. {                              O P T I O N      8                             }
  873. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  874. Procedure Unit_Summary;
  875. const
  876. X1 = 40;
  877. Y1 = 5;
  878. X2 = 80;
  879. Y2 = 25;
  880. var
  881. C1,C2,C3,C4 : byte;
  882.  
  883.  
  884.  
  885. begin
  886.     If BaseOfScreen = $b800 then
  887.     begin
  888.         C1 := white;
  889.         C2 := lightgray;
  890.         C3 := yellow;
  891.         C4 := blue;
  892.     end
  893.     else
  894.     begin
  895.         C1 := white;
  896.         C2 := black;
  897.         C3 := white;
  898.         C4 := lightgray;
  899.     end;
  900.     SaveScreen(1);
  901.     Fbox(1,1,80,24,C1,C4,1);
  902.     WriteCenter(2,C3,C4,'A Summary of the Toolkit Units');
  903.     WriteAT(3,4,c3,c4,'FastTTT  ');
  904.     WriteAT(12,4,c2,c4,'Ultra fast Screen writing routines including box drawing');
  905.     WriteAT(3,6,c3,c4,'WinTTT  ');
  906.     WriteAT(12,6,c2,c4,'Windowing routines together with screen moves, copies & saves');
  907.     WriteAT(3,8,c3,c4,'MenuTTT  ');
  908.     WriteAT(12,8,c2,c4,'Advanced, but easy to use, menu unit with auto-centering etc.');
  909.     WriteAT(3,10,c3,c4,'KeyTTT  ');
  910.     WriteAT(12,10,c2,c4,'Full keyboard control and a host of mouse related procedures');
  911.     WriteAT(3,12,c3,c4,'IOTTT  ');
  912.     WriteAT(12,12,c2,c4,'Form or full screen input procedues, with control of input');
  913.     WriteAT(3,14,c3,c4,'StrngTTT');
  914.     WriteAT(12,14,c2,c4,'Suite of fast string handling procs, including word manipulation');
  915.     WriteAT(3,16,c3,c4,'PullTTT');
  916.     WriteAT(12,16,c2,c4,'Easy to use procedure for displaying Pull down menus');
  917.     WriteAT(3,18,c3,c4,'DirTTT');
  918.     WriteAT(12,18,c2,c4,'Sidekick-like directory listing procedures');
  919.     WriteAT(3,20,c3,c4,'ReadTTT');
  920.     WriteAT(12,20,c2,c4,'Single line input control providing user with full editing');
  921.     WriteAT(3,22,c3,c4,'MiscTTT');
  922.     WriteAT(12,22,c2,c4,'A pot pourri of miscellaneous procedures and functions');
  923.     WriteAT(50,23,c2,c4,'Press any key to continue....');
  924.     Offcursor;
  925.     Ch := getkey;
  926.     SlideRestoreScreen(1,Up);
  927.     DisposeScreen(1);
  928. end;
  929.  
  930. Procedure Initialise;
  931. begin
  932.     Clrscr;
  933.     Box(25,1,55,4,white,black,1);
  934.     WriteBetween(25,55,2,lightgray,black,'Technojocks Turbo Toolkit');
  935.     WriteBetween(25,55,3,lightgray,black,'V4.0');
  936.     WriteCenter(6,white,black,'"In the software business since Tuesday"');
  937.     WriteAT(5,8,white,black,'This program demonstrates the power of TechnoJocks Turbo Toolkit for');
  938.     WriteAT(5,9,white,black,'Borlands Turbo Pascal v4.0 (IBM and compatibles).');
  939.     WriteAT(5,11,white,black,'The Toolkit is a professional ShareWare product and if you use the');
  940.     WriteAt(5,12,white,black,'Toolkit you must register it. Included in the source code is a file');
  941.     WriteAt(5,13,white,black,'Register.doc, print this file and submit it together with registration');
  942.     WriteAt(5,14,white,black,'fee of:');
  943.     WriteAt(10,16,white,black,' $29.95 for Full registration with 150 page typeset manual');
  944.     WriteAt(10,17,white,black,' $9.95  for full time Student registration');
  945.     WriteAt(5,19,white,black,'to:');
  946.     WriteAt(30,21,white,black,'Bob Ainsbury');
  947.     WriteAt(30,22,white,black,'Technojock');
  948.     WriteAt(30,23,white,black,'P.O. Box 2197');
  949.     WriteAT(30,24,white,black,'Houston, TX 77252');
  950.     WriteAT(55,25,white+blink,black,'Press any key to continue');
  951.     Ch := getkey;
  952.     Clrscr;
  953.     FillScreen(1,1,80,24,white,black,chr(176));
  954.     OffCursor;
  955.     WriteCenter(25,lightgray,black,'Technojocks Turbo Toolkit v4.0 ');
  956.     Main_Choice := 1;
  957.     Define_Menu1;
  958. end;
  959.  
  960. Procedure Finish;
  961. begin
  962.  ClrScr;
  963.  OnCursor;
  964.  write('TechnoJocks Turbo Toolkit');
  965.  Halt;
  966. end;
  967.  
  968. begin     {main program}
  969. Initialise;
  970. repeat
  971.      DisplayMenu(M1,false,Main_choice,Error);
  972.      Case Main_Choice of
  973.      1 :Toolkit_Explained;
  974.      2 :Explain_Fastwrite;
  975.      3 :Explain_Windows;
  976.      4 :Explain_Menu;
  977.      5 :Explain_IO;
  978.      6 :Explain_Dir;
  979.      7 :PrintOut;
  980.      8 :Unit_Summary;
  981.      9 :Finish;
  982.      end;  {case}
  983. until true = false;  {a very very very long time !}
  984. end.
  985.  
  986.